home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / disk_425.arc / NEWTON-L.LIB < prev    next >
Text File  |  1986-06-20  |  768b  |  42 lines
  1.  
  2.  
  3.  
  4. { -> 252 }
  5. procedure newton(var x: real);
  6. const    tol        = 1.0E-6;
  7.     max        = 20;
  8. var    fx,dfx,dx,x1    : real;
  9.     i        : integer;
  10.  
  11. begin    { newton }
  12.   error:=false;
  13.   i:=0;
  14.   repeat
  15.     i:=i+1;
  16.     x1:=x;
  17.     func(x,fx,dfx);
  18.     if dfx=0.0 then
  19.       begin
  20.     error:=true;
  21.     x:=1.0;
  22.     writeln(chr(7),'ERROR: slope zero')
  23.       end
  24.     else
  25.       begin
  26.     dx:=fx/dfx;
  27.     x:=x1-dx;
  28.     writeln('x=',x,'  fx=',fx,'  dfx=',dfx)
  29.       end
  30.   until
  31.     error or
  32.       (i>max) or
  33.     (abs(dx)<=abs(tol*x));
  34.   if i>max then
  35.     begin
  36.       writeln(chr(7),'ERROR: no convergence in ',max,' loops');
  37.       error:=true
  38.   end
  39. end;        { newton }
  40.  
  41.  
  42.